perm filename MSFAIL.FAI[DRW,LCS] blob sn#135019 filedate 1974-12-13 generic text, type T, neo UTF8
00100		TITLE MSSIO ; ********* JUN 8,74 *********
00200		INTERNAL GETFI2,FASTI2
00210		INTERNAL LOOK,LOOKD,LOOKF,PAC,UNPAC
00300	
00400	
00500		CH3←13
00600	
00700	DEFINE ERROR (MSG)
00800	<	JSA 16,.ERROR
00900		JUMP [ASCIZ/MSG/
01000	]
01100	>
01200	
01500	;CALL GETFI2(<FILE>)
01600	
01700	GETFI2:	0
01800		MOVE 0,@0(16)
01900		MOVEM 0,FILNAM
02000		JSA 16,INTFIZ
02100		MOVE 0,[SIXBIT/DMD/]
02200		MOVEM 0,DIR+1
02300		JSA 16,LKUP
02400		SKIPA
02500		JRST GETF3
02600		SETZM DIR+1
02700		JSA 16,LKUP
02800		0
02900	GETF3:	JRA 16,1(16)
03000	
03100	LKUP:	0
03200		SETZM DIR+2
03300		SETZM DIR+3
03400		LOOKUP CH3,DIR
03500		JRA 16,0(16)
03600		JRA 16,1(16)
03700	
03800	INTFIZ:	0	;INITS DSK FOR INPUT
03900		MOVEI REGS
04000		BLT REGS+3
04100		INIT CH3,17
04200		SIXBIT/DSK/
04300		0
04400		ERROR <CAN'T INIT DSK!>
04500		JRST INTF4
04600	
04900	
05000	;CALL FASTI2(<ARRAY>,<NO. WORDS>)
05100	
05200	FASTI2:	0
05300		HRRZ 0,0(16)
05400		SUBI 0,1
05500		MOVEM 0,COM
05600		MOVN 0,@1(16)
05700		HRLM 0,COM
05800		INPUT CH3,COM
05900		STATZ CH3,740000
06000		0
06100		JRA 16,2(16)
06200	
06300	COM:	OCT 0,0
06400	BLKNUM:	0
08200	
08300	.ERROR:	0
08400		OUTSTR [ASCIZ/?
08500	/]				;MAKE SURE HE CAN SEE HIS ERROR
08600		OUTSTR @(16)		;OUTPUT ERROR MESSAGE
08700		CALLI 1,12		;LET USER CONTI2UE
08800		JRA 16,1(16)
     

00300	
00400		CH←13
00500	
00600	REGS:	BLOCK 20
00700	
00800	;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
00900	
01000	LOOKF:	0
01100		MOVSI 0,'DMD'
01200		JRST LOOK1
01300	LOOKD:	0
01400		MOVSI 0,'DAT'
01500		JRST LOOK1
01600	LOOK:	0
01700		MOVEI	0,0
01800	LOOK1:	MOVEM	0,DIR+1
01900		MOVE	0,@(16)
02000		MOVEM 	0,FILNAM
02100		JSA 16, INTFIQ
02200		SETZM	DIR+2
02300		SETZM	DIR+3
02400		LOOKUP	CH,DIR
02500		TDZA	0,0
02600		MOVNI	0,1
02700		JRA 16,1(16)
02800	
02900	INTFIQ:	0	;INITS DSK FOR INPUT
03000		MOVEI REGS
03100		BLT REGS+3
03200		INIT CH,17
03300		SIXBIT/DSK/
03400		0
03500		HALT .-3
03600	;	ERROR <CAN'T INIT DSK!>
03700	
03800	INTF4:	MOVE 0,FILNAM#
03900		MOVEM 0,FN#
04000		MOVE 1,[POINT 7,FN]
04100	INTF3:	MOVE 2,[POINT 6,DIR]
04200		SETZM DIR
04300		MOVEI 3,5
04400	INTF1:	ILDB 0,1
04500		CAIN 0," "
04600		JRST INTF2
04700		SUBI 0,40
04800		IDPB 0,2
04900		SOJG 3,INTF1
05000	INTF2:	HRLZI REGS
05100		BLT 3
05200		JRA 16,0(16)
05300	
05400	DIR:	BLOCK 4
05500	
05600	
05700	PAC:	0		;CALL PAC(PW,AR)
05800		HRRZ 1,1(16)
05900		ADDI 1,2
06000		HRR 2,@1	;SIZE IS 12 BITS
06100		LSHC 2,-10
06200		SOJ 1,
06300		HRR 2,@1
06400		LSHC 2,-16
06500		SOJ 1,
06600		HRR 2,@1
06700		LSHC 2,-16
06800		MOVEM 3,@0(16)
06900		JRA 16,2(16)
07000	UNPAC:	0		;CALL UNPAC(PW,AR)
07100		HRRZ 1,1(16)
07200		ADDI 1,2
07300		MOVE 2,@0(16)
07400		LSHC 2,-10
07500		ASH 3,-34
07600		MOVEM 3,@1
07700		SOJ 1,
07800		LSHC 2,-16
07900		ASH 3,-26
08000		MOVEM 3,@1
08100		SOJ 1,
08200		LSHC 2,-16
08300		ASH 3,-26
08400		MOVEM 3,@1
08500		JRA 16,2(16)
08600		END